library(recommenderlab)
## Loading required package: Matrix
## Loading required package: arules
##
## Attaching package: 'arules'
## The following objects are masked from 'package:base':
##
## abbreviate, write
## Loading required package: proxy
##
## Attaching package: 'proxy'
## The following object is masked from 'package:Matrix':
##
## as.matrix
## The following objects are masked from 'package:stats':
##
## as.dist, dist
## The following object is masked from 'package:base':
##
## as.matrix
## Registered S3 methods overwritten by 'registry':
## method from
## print.registry_field proxy
## print.registry_entry proxy
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tidyr::expand() masks Matrix::expand()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tidyr::pack() masks Matrix::pack()
## ✖ dplyr::recode() masks arules::recode()
## ✖ tidyr::unpack() masks Matrix::unpack()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
data("MovieLense")
user_item_ratings <- as(MovieLense, "data.frame")
user_df <- MovieLenseUser
movie_genre_df <- MovieLenseMeta
Die Daten sind nun in den Dataframes user_item_ratings, user_df und movie_genre_df gespeichert.
# Datentypen der user_item_ratings anpassen
user_item_ratings <- user_item_ratings %>%
mutate(user = as.factor(user), item = as.factor(item), rating = as.integer(rating))
library(reshape2)
##
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
##
## smiths
# Transformation der Ratings in binäre Werte mit 1 für Rating > 3 und 0 sonst
user_item_ratings$binarizedRating <- as.integer(ifelse(user_item_ratings$rating > 3, 1, 0))
# Erstellen der User-Liked-Items Matrix
user_liked_df <- dcast(user_item_ratings, user ~ item, value.var = "binarizedRating", fill = 0)
# Anzeigen der erstellten Matrix
head(user_liked_df)
In dem Dataframe sind nun pro User alle Filme welche mit einer 3 oder höher bewertet wurden als 1 gespeichert. 1 Bedeutet somit, dass der Film dem User gefallen hat. Alle Ratings unter 3 werden mit 0 gespeichert und bedeuten, dass der Film nicht gefallen hat.
Da es nun noch ein DF ist werde ich das in eine Matrix umwandeln und die User IDs als Index verwenden.
# user_liked_matrix as matrix machen und user IDs als index nehmen
user_liked_matrix <- as.matrix(user_liked_df[,-1])
rownames(user_liked_matrix) <- user_liked_df[,1]
Nun ist es als Matrix gespeichert, womit ich es für zukünftige Rechenoperationen verwenden kann.
dim(user_liked_matrix)
## [1] 943 1664
Die Dimensionen der user_liked_matrix machen Sinn, da die Anzahl der User mit der Anzahl der Zeilen und die Anzahl der Items mit der Anzahl der Spalten übereinstimmt. Pro Spalte befindet sich jewils ein Film und pro Zeile ein User.
# Setzen der Filmnamen als Zeilenindex
rownames(movie_genre_df) <- movie_genre_df[,1]
# Die ersten 3 Spalten Titel, Jahr und URL löschen und nur die Genres behalten
movie_genre_df_reduced <- movie_genre_df[,-c(1,2,3)]
# df umwandeln in eine Matrix
movie_genre_matrix <- as.matrix(movie_genre_df_reduced)
Die movie_genre_matrix hat nun auf den Zeilen die Filme und auf den Spalten die Genres. Die Werte in der Matrix sind 1 wenn der Film das Genre hat und 0 wenn nicht.
dim(movie_genre_matrix)
## [1] 1664 19
Die Dimensionen dieser Matrix machen ebenfalls Sinn. Die Anzahl der Filme stimmt mit der Anzahl Zeilen überein. Auch alle 19 Genres sind in den Spalten enthalten.
# Erstellen einer Genre-Kombinations-Spalte
genre_combinations <- apply(movie_genre_matrix[, -1], 1, function(x) paste(names(x)[x == 1], collapse = ", "))
# Zählen der Häufigkeiten der Genre-Kombinationen
genre_combination_counts <- table(genre_combinations)
# Umwandeln in einen DataFrame
genre_combination_df <- as.data.frame(genre_combination_counts)
# Sortieren und Top 29 auswählen
top_genre_combinations <- genre_combination_df[order(-genre_combination_df$Freq), ][1:29, ]
# Hinzufügen der Kategorie "Others combined"
others_combined <- sum(genre_combination_df$Freq) - sum(top_genre_combinations$Freq)
top_genre_combinations <- rbind(top_genre_combinations, data.frame(genre_combinations = "Others combined", Freq = others_combined))
# Gesamtanzahl der Kombinationen
total_combinations <- length(genre_combination_counts)
# Identifizieren der größten Genre-Kombination
max_freq <- max(top_genre_combinations$Freq)
top_genre_combinations$Color <- ifelse(top_genre_combinations$Freq == max_freq, "orchid", "skyblue")
# Visualisierung mit ggplot2
ggplot(top_genre_combinations, aes(x = genre_combinations, y = Freq, fill = Color)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_identity() +
labs(title = "Verteilung der Filme nach Genre-Kombination", subtitle = paste("Top 30 Genre-Kombinationen von insgesamt: ", total_combinations), x = "Genre-Kombination", y = "Anzahl der Filme") +
theme_minimal()
Others combined wäre die am häufigsten vorkommende Genre-Kombination, wenn es denn eine wäre. Das tatsächlich häfuigste Genre ist Drama, gefolgt von Comedy. Diese drei Genre-Kombinationen machen zusammen den Grossteil aller Genrekombinationen von den Top 30 aus. Ich finde es sehr interessant zu sehen, dass das Genre Drama insgesammt fast so häufig vertreten ist wie alle “Others Combined” Kombinationen.
Für diese Aufgabe muss ich zuerst die movie_genre_matrix nach Titel absteigend sortieren, da ich sie mit der user_liked_matrix mulitplitzieren möchte und diese ebenfalls nach Filmtitel absteigend sortiert ist.
# Sortiere movie_genre_matrix nach Titel absteigend, damit es für die Berechnung geht
movie_genre_matrix <- movie_genre_matrix[order(rownames(movie_genre_matrix), decreasing = FALSE), ]
# Matrixmultiplikation
user_genre_profile_matrix <- user_liked_matrix %*% movie_genre_matrix
# Anzeigen der ersten Nutzerprofile
head(user_genre_profile_matrix)
## unknown Action Adventure Animation Children's Comedy Crime Documentary
## 1 1 39 17 5 5 49 15 5
## 10 0 25 14 7 8 39 16 3
## 100 0 6 1 0 0 4 2 0
## 101 0 9 7 0 0 4 1 0
## 102 0 10 6 3 2 6 1 0
## 103 0 8 4 0 0 4 3 0
## Drama Fantasy Film-Noir Horror Musical Mystery Romance Sci-Fi Thriller War
## 1 77 1 1 7 6 3 29 32 30 15
## 10 73 1 9 6 13 15 32 11 33 19
## 100 11 0 2 0 0 2 3 3 9 2
## 101 4 0 0 1 0 1 7 4 5 3
## 102 4 0 1 5 4 1 3 11 4 1
## 103 5 0 0 0 0 0 4 4 3 3
## Western
## 1 3
## 10 5
## 100 0
## 101 0
## 102 1
## 103 0
Die user_genre_profile_matrix gibt an, wie oft ein user ein bestimmtes Genre geliked, respektive mit einer 3 oder höher bewertet hat.
dim(user_genre_profile_matrix)
## [1] 943 19
Die Dimensionen der Matrix machen Sinn. Die Anzahl der User stimmt mit der Anzahl der Zeilen überein. Auch alle 19 Genres sind in den Spalten enthalten. Dies habe ich so erwartet, da ich eine Matrix wollte, in der man für jeden User sieht, welches Genre wie oft geliked wurde.
a.) wieviele Nutzerprofile gibt es wenn die Stärke der Genre-Kombination vollständig berücksichtigt wird?
# Länge der unique Userprofiles ausgeben mit aktuellen Werten
length(unique(apply(user_genre_profile_matrix, 1, paste, collapse = ", ")))
## [1] 943
Wenn die Stärke der Genre_Kombination vollständig berücksichtigt wird, gibt es 943 unterschiedliche Nutzerprofile. Dies heisst, dass alle User ein unterschiedliches Nutzerprofil haben.
b.) Wieviele Nutzerprofile gibt es wenn die Stärke der Genre-Kombination binär berücksichtigt wird?
# Länge der unique Userprofiles ausgeben für 1, falls 1 oder höher und 0 sonst
length(unique(apply(user_genre_profile_matrix > 0, 1, paste, collapse = ", ")))
## [1] 381
Wenn man einfach nur schaut, ob ein User mindestens ein Film von einem Genre geliked hat oder nicht, gibt es nur 381 unterschiedliche Nutzerprofile. Es gibt also einige User, welche liked Items in den selben Genres haben.
# funktion calc_cos_similarity_twomtrx definieren
calc_cos_similarity_twomtrx <- function(matrix_1, matrix_2) {
# Berechnung der Normen für beide Matrizen
norms_matrix_1 <- sqrt(rowSums(matrix_1^2))
norms_matrix_2 <- sqrt(rowSums(matrix_2^2))
# Berechnung des äußeren Produkts der Normen
#(unterer teil der Formel für Cosinus-Ähnlichkeit)
norm_product <- outer(norms_matrix_1, norms_matrix_2, "*")
# Berechnung der Cosinus-Ähnlichkeit
cosine_similarity <- (matrix_1 %*% t(matrix_2)) / norm_product
return(cosine_similarity)
}
# Erstellen von Testmatrizen
matrix_1 <- matrix(c(1,0,2,1,1,0), nrow = 2, ncol = 3, byrow = TRUE)
matrix_2 <- matrix(c(1,1,1,0,1,0), nrow = 2, ncol = 3, byrow = TRUE)
# Funktion mit kleinen Matrizen testen
cos_similarity_eigeneMatrix <- calc_cos_similarity_twomtrx(matrix_1, matrix_2)
print(cos_similarity_eigeneMatrix)
## [,1] [,2]
## [1,] 0.7745967 0.0000000
## [2,] 0.8164966 0.7071068
Das Resultat habe ich schriftlich geprüft und bin auf das gleiche Resultat gekommen. Somit kann ich bestätigen, dass die Berechnungen für die Cosine-Similarity funktionieren. Daher kann ich nun die Cosinusähnlichkeiten für die Matrizen user_genre_profile_matirx und movie_genre_matrix berechnen.
# Cosinus-Ähnlichkeit zwischen User-Genre- und Movie-Genre-Matrix berechnen
cosine_similarity_matrix <- calc_cos_similarity_twomtrx(user_genre_profile_matrix, movie_genre_matrix)
# erste 5 Zeilen und Spalten ausgeben
cosine_similarity_matrix[1:5, 1:5]
## 'Til There Was You (1997) 1-900 (1994) 101 Dalmatians (1996)
## 1 0.6442370 0.2492601 0.3281962
## 10 0.7021566 0.3026284 0.3142987
## 100 0.5823232 0.1764706 0.1663781
## 101 0.4787136 0.4308202 0.1740777
## 102 0.2496817 0.1513300 0.2853506
## 12 Angry Men (1957) 187 (1997)
## 1 0.6618286 0.6618286
## 10 0.6903710 0.6903710
## 100 0.6470588 0.6470588
## 101 0.2461830 0.2461830
## 102 0.2017733 0.2017733
dim(cosine_similarity_matrix)
## [1] 943 1664
Die Dimension stimmt wieder mit der Anzahl der User und der Anzahl der Filme überein. Dies sollte so sein, da die Cosinus-Ähnlichkeit zwischen User-Genre- und Movie-Genre-Matrix berechnet wurde. Also haben wir für jeden User und jeden Film eine Cosine-Similarity welche angibt, wie sehr der Film zu dem User passen sollte.
# Konvertierung der Matrix in einen Vektor
cos_similarity_vector <- as.vector(cosine_similarity_matrix)
# Berechnung der 5-Zahlen-Statistik
min_value <- min(cos_similarity_vector, na.rm = TRUE)
first_quartile <- quantile(cos_similarity_vector, 0.25, na.rm = TRUE)
median_value <- median(cos_similarity_vector, na.rm = TRUE)
third_quartile <- quantile(cos_similarity_vector, 0.75, na.rm = TRUE)
max_value <- max(cos_similarity_vector, na.rm = TRUE)
# Berechnung des Mittelwerts
mean_value <- mean(cos_similarity_vector, na.rm = TRUE)
# Berechnung der Anzahl von NAs
na_count <- sum(is.na(cos_similarity_vector))
# Ausgabe der Statistiken
cat("5-Zahlen-Statistik der Cosinus-Ähnlichkeiten:\n",
"Minimum:", min_value, "\n",
"1. Quartil:", first_quartile, "\n",
"Median:", median_value, "\n",
"3. Quartil:", third_quartile, "\n",
"Maximum:", max_value, "\n",
"Mittelwert:", mean_value, "\n",
"Anzahl von NAs:", na_count, "\n")
## 5-Zahlen-Statistik der Cosinus-Ähnlichkeiten:
## Minimum: 0
## 1. Quartil: 0.2300219
## Median: 0.4070324
## 3. Quartil: 0.5919163
## Maximum: 0.9767817
## Mittelwert: 0.4098111
## Anzahl von NAs: 1664
Der kleinste Wert in der Statistik ist das Minimum 0, was darauf hindeutet, dass der niedrigste Wert der Cosinus-Ähnlichkeit 0 ist. Dies könnte bedeuten, dass es Paare von Elementen gibt, die gar keine Ähnlichkeit haben.
25% der Ähnlichkeiten liegen unter 0.230.
Der Median von 0.407 bedeutet, dass die Hälfte der Cosinus-Ähnlichkeitswerte über diesem Wert und die andere Hälfte unter diesem Wert liegt.
Mit 0.591 als 3. Quartil sind 75% der Cosinus-Ähnlichkeitswerte unter diesem Wert.
Der höchstwert in der Cosine_similarity_matrix ist 0.977. Dies ist eine sehr hohe Ähnlichkeit, welche eine fast perfekte Empfehlung abgeben würde.
# NA-Werte entfernen aus dem Vektor
cos_similarity_vector <- cos_similarity_vector[!is.na(cos_similarity_vector)]
# Erstellen eines DataFrames für die ggplot2 Funktion
cos_similarity_df <- data.frame(CosineSimilarity = cos_similarity_vector)
# Erstellen des Dichteplots
ggplot(cos_similarity_df, aes(x = CosineSimilarity)) +
geom_density(fill = "orchid", alpha = 0.4) +
labs(title = "Dichteplot der Cosinus-Ähnlichkeiten",
x = "Cosinus-Ähnlichkeit",
y = "Dichte") +
theme_minimal()
In dem Plot sieht man wie in der 5 Zahlen Statistik, dass es einige (sogar mehr als ich dachte) 0 Werte in den Cosinus Ähnlichkeiten gibt. Die Ähnlichkeiten sehen hier annähernd normalverteilt aus mit einem Mittelwert von ca. 0.4. Auch dies lässt sich mit der 5 Zahlen Statistik bestätigen.
user_ids <- c("241", "414", "477", "526", "640", "710")
# Erstellen eines DataFrames für die ggplot2 Funktion
cos_similarity_long_df <- data.frame(CosineSimilarity = numeric(), User = factor())
# Extrahieren der Cosinus-Ähnlichkeitswerte für jeden Nutzer und Hinzufügen zum DataFrame
for (user_id in user_ids) {
user_similarity <- cosine_similarity_matrix[user_id, ]
user_similarity <- user_similarity[!is.na(user_similarity)] # Entfernen von NA-Werten
cos_similarity_long_df <- rbind(cos_similarity_long_df, data.frame(CosineSimilarity = user_similarity, User = as.factor(user_id)))
}
# Erstellen des Dichteplots mit unterschiedlichen Farben für jeden Nutzer
ggplot(cos_similarity_long_df, aes(x = CosineSimilarity, fill = User)) +
geom_density(alpha = 0.5) +
facet_wrap(~ User, ncol = 2) +
labs(title = "Dichteplot der Cosinus-Ähnlichkeiten für ausgewählte Nutzer",
x = "Cosinus-Ähnlichkeit",
y = "Dichte") +
theme_minimal() +
scale_fill_brewer(palette = "PuRd")
Die Verteilungen der Cosinus-Ähnlichkeiten für die 6 Nutzern sehen recht
unterschiedlich aus. Sehr auffällig ist, die Verteilung vom User 640, da
er sehr viele Ähnlichkeiten im bereich 0.4 - 0.6 hat. Die andern sehen
sehr ähnlich aus mit Peaks bei niedrigen und bei hohen
Cosinus-Ähnlichkeiten. Similaritys von 0.4 - 0.6 sind bei den andern
Usern eher selten vorgekommen im Vergelich zu User 640.
Um die Negativabzug Matrix zu erstellen brauche ich zuerst den Dataframe, in dem ersichtlich ist, welche Filme von welchen Nutzern bewertet wurden. Dabei ist zu beachten, dass die Filme, welche nicht bewertet wurden, mit 0 angegeben werden.
# Date Frame erstellen mit User und Filmen, welche ein Rating haben = 1. Sonst = 0
user_watched_df <- dcast(user_item_ratings, user ~ item, value.var = "rating", fill = 0)
# Wo ein Rating ist auf 1 setzen, wo keines ist auf 0.
user_watched_df[, -1] <- ifelse(user_watched_df[, -1] > 0, 1, 0)
Nun kann ich die Negativabzug Matrix erstellen. Dabei wird die Matrix mit 0 initialisiert und dann mit einer ifelse Funktion die Werte, welche 0 sind, auf 1 gesetzt und umgekehrt. Somit sollten dann alle Filme, welche nicht bewertet wurden, mit 1 angegeben werden und die bewerteten mit 0.
# Filme, die nicht bewertet wurden (0), werden zu 1, und bewertete Filme (1) werden zu 0, ausser 1. spalte bleibt gleich
negativabzug_matrix <- user_watched_df
negativabzug_matrix[, -1] <- ifelse(negativabzug_matrix[, -1] == 0, 1, 0)
# Ausgewählte Nutzer-IDs
selected_users <- c("5", "25", "50", "150")
# Berechnung der Zeilensummen für die ausgewählten Nutzer
for (user in selected_users) {
user_row_sum <- sum(negativabzug_matrix[negativabzug_matrix$user == user, -1])
cat("Zeilensumme des Negativabzuges für Nutzer", user, ":", user_row_sum, "\n")
}
## Zeilensumme des Negativabzuges für Nutzer 5 : 1489
## Zeilensumme des Negativabzuges für Nutzer 25 : 1586
## Zeilensumme des Negativabzuges für Nutzer 50 : 1641
## Zeilensumme des Negativabzuges für Nutzer 150 : 1633
Die Zeilensumme des Negativabzuges für die vier ausgewählten Nutzer bedeuten, wieviele filme von den 1664 filmen KEINE BEWERTUNG haben. Dabei sehen wir, dass der User 5 ca. 180 Filme bewertet hat. Die anderen User haben weniger Filme bewertet. Beim User 50 sehen wir, dass er nur 15 Ratings abgegeben hat, was sehr wenig ist.
# Berechnung der Zeilensummen
zeilensummen <- rowSums(negativabzug_matrix[, -1])
# Berechnung der 5-Zahlen-Statistik
min_value <- min(zeilensummen)
erstes_quartil <- quantile(zeilensummen, 0.25)
median_value <- median(zeilensummen)
drittes_quartil <- quantile(zeilensummen, 0.75)
max_value <- max(zeilensummen)
# Ausgabe der 5-Zahlen-Statistik
cat("5-Zahlen-Statistik der Zeilensummen des Negativabzuges:\n",
"Minimum:", min_value, "\n",
"1. Quartil:", erstes_quartil, "\n",
"Median:", median_value, "\n",
"3. Quartil:", drittes_quartil, "\n",
"Maximum:", max_value, "\n")
## 5-Zahlen-Statistik der Zeilensummen des Negativabzuges:
## Minimum: 929
## 1. Quartil: 1516.5
## Median: 1600
## 3. Quartil: 1632
## Maximum: 1645
In der 5-Zahlen Statistik für den Negativabzug sehen wir das Maximum von 1645, das bedeutet, dass jeder User mindestens 11 Bewertungen abgegeben haben muss, da sonst das Maximum bei 1664 wäre.
das Minimum liegt bei 929, daher kann man sehen dass es ein User gibt, welcher ganze 735 Filme bewertet hat. (1664 - 929). Der Median liegt bei genau 1600, was bedeutet dass 50% der User mehr als 64 Filme bewertet haben und 50% weniger als 64.
# Rownames für negativabzug_matrix als User_ids setzen
rownames(negativabzug_matrix) <- negativabzug_matrix$user
# droppen der user Spalte
negativabzug_matrix <- negativabzug_matrix[, -1]
masked_df <- cosine_similarity_matrix * negativabzug_matrix
masked_df